unit uSBDUnit_TestNodeImpl;
interface
uses uSBDUnit_Model, Classes, uSBDUnit_Types, uSBD_BaseTypes,
    uSBDUnit_TestNode_InternalSupport, uSBD_ServiceProvider;


type
TTestNode = class abstract( TSBD_RefCountedCommonBase, ITestNode, ITestNodeEx)
  private
    FName              : string;
    FExecutionStartTime: TDateTime;
    FExecutionEndTime  : TDateTime;
    FViewToken         : TObject;
    FParent            : ITestNode;
    FUpward            :  IUpwardPropagator;

    // ITestNode
  protected
    [Injection] FMaster: INodeMaster;
    FKind              : TNodeKind;
    FEnabled           : boolean;
    FExecResult_Overall: TExecutionResult;
    FStatus            : TTestStatus;
    FFailCount         : integer;
    FExecuteCount      : integer;
    FLoadCount         : integer;
    FTernaryChecked    : TTernary;

    function  GetExecResult_Overall: TExecutionResult;
    function  ITestNode  .GetExecResult = GetExecResult_Overall;
    function  ITestNodeEx.GetExecResult = GetExecResult_Overall;

  private
    procedure SetName( const Value: string);
    function  GetEnabled: boolean;
    function  GetStatus: TTestStatus;
    function  GetName: string;
    function  GetKind: TNodeKind;
    function  GetExecutionStartTime: TDateTime;
    function  GetExecutionEndTime: TDateTime;
    function  GetExecutionDuration: TDateTime;
    function  GetFailCount: integer;
    function  GetExecuteCount: integer;
    function  GetLoadCount: integer;
    function  GetViewToken: TObject;
    procedure SetViewToken( Value: TObject);
    function  GetParent: ITestNode;
    procedure SetMeter( var MeterField: integer; NewValue: integer; Prop: TChangeableNodeProperty);
    function  GetTernaryChecked: TTernary;

  protected
    procedure SetEnabled( Value: boolean);           virtual;
    function  GetChild( Idx: integer): ITestNode;    virtual;
    function  GetCount: integer;                     virtual;

    // ITestNodeEx
    procedure SetFailCount   ( Value: integer);      virtual;
    procedure SetExecuteCount( Value: integer);      virtual;
    procedure SetLoadCount   ( Value: integer);      virtual;
    procedure AddChild( const Newbie: ITestNode);    virtual;
    procedure SetStatus( Value: TTestStatus; Stamp: TDateTime);  overload;
    procedure SetStatus( Value: TTestStatus);                    overload;
    procedure Clear;                                 virtual;
    procedure SkipDisabledDeep;                      virtual;
    procedure SetEnabledDeep( Value: boolean);       virtual;
    procedure SetTestResult_Overall( Value: TExecutionResult);   virtual;
    function  AddNewChild( Kind: TNodeKind; const Name: string = ''): ITestNode;  virtual;
    procedure ShutDown;                              virtual;
    procedure UpdateTernaryChecked( doNotifications: boolean);
    function  HaveAnyDisabledOrOmegaChildren: boolean;           virtual;
    procedure DisableChildren;                       virtual;

  protected
    FdoingSetEnabledDeep  : boolean;
    FdoingSkipDisabledDeep: boolean;

    function  IntrinsicFailCount      : integer;     virtual;
    function  InstrinsicExecutionCount: integer;     virtual;
    function  IntrinsicLoadCount      : integer;     virtual;
    function  ComputeFailCount        : integer;     virtual;
    function  ComputeExecutionCount   : integer;     virtual;
    function  ComputeLoadCount        : integer;     virtual;
    procedure PropsChanged( ChangeSet: TChangeableNodePropertySet);
    procedure SetEnabledDeepChildren;    virtual;
    procedure SkipDisabledDeepChildren;  virtual;
    procedure SetParentNodeAsIntf( const Value: IInterface);    override;

  public
    constructor ServiceModeCreate;   virtual;
  end;





TTestNodeNonLeaf = class abstract( TTestNode, ITestNodeNonLeafEx, IUpwardPropagator)
  private
    FChildren: IInterfaceList; // of ITestNode

    // IUpwardPropagator
    procedure DownwardStatusChange( Value: TTestStatus; const Child: ITestNode; Stamp: TDateTime);
    procedure DownwardFailCountChange( Delta: integer; const Child: ITestNode);
    procedure DownwardExecCountChange( Delta: integer; const Child: ITestNode);
    procedure DownwardLoadCountChange( Delta: integer; const Child: ITestNode);
    procedure DownwardExecutionResultChange( ChildResult: TExecutionResult; const Child: ITestNode);

  protected
    function  ITestNodeNonLeafEx.GetExecResult = GetExecResult_Overall;
    function  GetChild( Idx: integer): ITestNode;    override;
    function  GetCount: integer;                     override;
    procedure AddChild( const Newbie: ITestNode);    override;
    procedure Clear;                                 override;
    function  AddNewChild( Kind: TNodeKind; const Name: string = ''): ITestNode;  override;
    function  ComputeFailCount        : integer;     override;
    function  ComputeExecutionCount   : integer;     override;
    function  ComputeLoadCount        : integer;     override;
    procedure SetEnabledDeepChildren;                override;
    procedure SkipDisabledDeepChildren;              override;
    function  HaveAnyDisabledOrOmegaChildren: boolean; override;
    procedure DisableChildren;                       override;

  public
    constructor ServiceModeCreate;                   override;
  end;





implementation





uses SysUtils, TypInfo;

{ TTestNode }

constructor TTestNode.ServiceModeCreate;
var
  NewEnabled: boolean;
begin
FExecResult_Overall := erNull;
FEnabled            := False;
FStatus             := sReady;
FTernaryChecked     := TernaryFalse;
if assigned( FParent) then
    NewEnabled := FParent.Enabled
  else
    NewEnabled := True;
if FEnabled <> NewEnabled then
  begin
  FEnabled := NewEnabled;
  UpdateTernaryChecked( False)
  end
// Note: FName and FKind need to be set by descendant constructor
//    FName              : string;
//    FKind              : TNodeKind;
end;


procedure TTestNode.AddChild(const Newbie: ITestNode);
begin
end;

function TTestNode.AddNewChild( Kind: TNodeKind; const Name: string): ITestNode;
var
  Parent: ITestNodeNonLeafEx;
  Addend: ITestNodeEx;
begin
if AcquireService( ITestNode, result, TypInfo.GetEnumName(
  TypeInfo( TNodeKind), Ord( Kind))) then
    begin
    if Supports( self, ITestNodeNonLeafEx, Parent) then
      Parent.AddChild( result);
    if (Name <> '') and Supports( result, ITestNodeEx, Addend) then
      Addend.SetName( Name)
    end
  else
    result := nil
end;

procedure TTestNode.Clear;
var
  Changes: TChangeableNodePropertySet;
begin
FdoingSetEnabledDeep  := False;
FdoingSkipDisabledDeep:= False;
Changes := [];
if FFailCount <> 0 then
  Include( Changes, propFailCount);
if FExecuteCount <> 0 then
  Include( Changes, propExecCount);
FFailCount    := 0;
FExecuteCount := 0;
if FExecResult_Overall <> erNull then
  Include( Changes, propExecResult);
FExecResult_Overall := erNull;
if FStatus <> sReady then
  begin
  FStatus := sReady;
  Include( Changes, propStatus)
  end;
if (FExecutionStartTime <> 0.0) or (FExecutionEndTime <> 0.0) then
  Include( Changes, propTimes);
FExecutionStartTime := 0.0;
FExecutionEndTime   := 0.0;
PropsChanged( Changes)
end;

function TTestNode.ComputeExecutionCount: integer;
begin
if FEnabled then
    result := InstrinsicExecutionCount
  else
    result := 0
end;

function TTestNode.ComputeFailCount: integer;
begin
if FEnabled then
    result := IntrinsicFailCount
  else
    result := 0
end;

function TTestNode.ComputeLoadCount: integer;
begin
if FEnabled then
    result := IntrinsicLoadCount
  else
    result := 0
end;

function TTestNode.GetChild( Idx: integer): ITestNode;
begin
end;

function TTestNode.GetCount: integer;
begin
result := 0
end;

function TTestNode.GetEnabled: boolean;
begin
result := FEnabled
end;

function TTestNode.GetExecResult_Overall: TExecutionResult;
begin
result := FExecResult_Overall
end;

function TTestNode.GetExecuteCount: integer;
begin
result := FExecuteCount
end;

function TTestNode.GetExecutionDuration: TDateTime;
begin
if (FExecutionStartTime <> 0.0) and (FExecutionEndTime <> 0.0) then
    result := FExecutionEndTime - FExecutionStartTime
  else
    result := 0.0
end;

function TTestNode.GetExecutionEndTime: TDateTime;
begin
result := FExecutionEndTime
end;

function TTestNode.GetExecutionStartTime: TDateTime;
begin
result := FExecutionStartTime
end;

function TTestNode.GetFailCount: integer;
begin
result := FFailCount
end;

function TTestNode.GetKind: TNodeKind;
begin
result := FKind
end;

function TTestNode.GetLoadCount: integer;
begin
result := FLoadCount
end;

function TTestNode.GetName: string;
begin
result := FName
end;

function TTestNode.GetParent: ITestNode;
begin
result := FParent
end;

function TTestNode.GetStatus: TTestStatus;
begin
result := FStatus
end;

function TTestNode.GetTernaryChecked: TTernary;
begin
result := FTernaryChecked
end;

function TTestNode.GetViewToken: TObject;
begin
result := FViewToken
end;

function TTestNode.InstrinsicExecutionCount: integer;
begin
result := 0
end;

function TTestNode.IntrinsicFailCount: integer;
begin
result := 0
end;

function TTestNode.IntrinsicLoadCount: integer;
begin
result := 0
end;

procedure TTestNode.PropsChanged( ChangeSet: TChangeableNodePropertySet);
begin
if assigned( FMaster) then
  FMaster.NodePropertiesChanged( self, ChangeSet)
end;

procedure TTestNode.SetMeter( var MeterField: integer; NewValue: integer; Prop: TChangeableNodeProperty);
var
  Delta: integer;
begin
if not FEnabled then
  NewValue := 0;
Delta := NewValue - MeterField;
if Delta = 0 then exit;
MeterField := NewValue;
PropsChanged( [Prop]);
if assigned( FUpward) then
  case Prop of
    propFailCount: FUpward.DownwardFailCountChange( Delta, self);
    propExecCount: FUpward.DownwardExecCountChange( Delta, self);
    propLoadCount: FUpward.DownwardLoadCountChange( Delta, self);
    end
end;


procedure TTestNode.SetName( const Value: string);
begin
FName := Value
end;

procedure TTestNode.SetParentNodeAsIntf( const Value: IInterface);
begin
Supports( Value, ITestNode        , FParent);
Supports( Value, IUpwardPropagator, FUpward)
end;

procedure TTestNode.SetExecuteCount( Value: integer);
begin
SetMeter( FExecuteCount, Value, propExecCount)
end;


procedure TTestNode.SetFailCount( Value: integer);
begin
SetMeter( FFailCount, Value, propFailCount)
end;

procedure TTestNode.SetLoadCount( Value: integer);
begin
SetMeter( FLoadCount, Value, propLoadCount)
end;

procedure TTestNode.SetStatus( Value: TTestStatus; Stamp: TDateTime);
begin
if FStatus = Value then exit;
FStatus := Value;
if (FStatus in [sTesting, sTearingDown]) and (Stamp = 0.0) then
  Stamp := Now;
case FStatus of
  sTesting    :  FExecutionStartTime := Stamp;
  sTearingDown:  FExecutionEndTime   := Stamp;
  end;
if FStatus in [sTesting, sTearingDown] then
  PropsChanged( [propTimes]);
PropsChanged( [propStatus]);
if assigned( FUpward) and FEnabled then
  FUpward.DownwardStatusChange( FStatus, self, Stamp);
end;

procedure TTestNode.SetStatus( Value: TTestStatus);
begin
SetStatus( Value, 0.0)
end;

procedure TTestNode.SetTestResult_Overall( Value: TExecutionResult);
begin
if FExecResult_Overall = Value then exit;
FExecResult_Overall := Value;
PropsChanged([propExecResult]);
if (FExecResult_Overall in [erPass, erFail]) and assigned( FUpward) then
  FUpward.DownwardExecutionResultChange( FExecResult_Overall, self)
end;

procedure TTestNode.SetViewToken( Value: TObject);
begin
FViewToken := Value
end;

procedure TTestNode.ShutDown;
begin
FServiceProvider := nil;
FParent := nil;
FMaster := nil
end;


procedure TTestNode.SkipDisabledDeepChildren;
begin
end;

procedure TTestNode.SkipDisabledDeep;
begin
FdoingSkipDisabledDeep := True;
try
  if not FEnabled then
    SetStatus( sSkipped);
  SkipDisabledDeepChildren
finally
  FdoingSkipDisabledDeep := False
  end
end;



// ===============================================================
//Rules for Enabled property
//
//There is only one fundamental rule, from which all others are derived.
//The fundamental rule is:
//  The enabled property of each node is independant, except for the following constraint.
//    1. if a node is disabled then all of its children are disabled (deeply).
//
//In addition to the read/write boolean property of Enabled, nodes also have
// a closely related ternary read-only property called TernaryChecked. Although
// this is a computed value, is cached for performance and ease of change detection.
// The values of TernaryChecked are:
//   TernaryFalse: Meaning that the node is disabled.
//   TernaryTrue : Meaning that the node and all its children are deeply enabled.
//   TernaryOmega: Meaning that the node is enabled but at least one of its
//
//Consequential rules are:
//1. When a node transits from disabled to enabled the following flow-on effects occur:
// 1.1 The parent node, if exists and disabled, is enabled.
// 1.2 TernaryChecked is checked for potential change. if it has any children,
//   the new value is TernaryOmega. Otherwise the new value is TernaryTrue.
// 1.3 The views are notified.
// 1.4 The load count is recomputed, possibly resulting in respective view notification.
//2. When a node transits from enabled to disabled the following flow-on effects occur:
// 2.1 All enabled children are disabled.
// 2.2 TernaryChecked transits to TernaryFalse.
// 2.3 The views are notified.
// 2.4 The load count is recomputed, possibly resulting in respective view notification.
//3. When a node is created, the following enable-related effects occur:
// 3.1 Enabled is initialised to the Enabled state of the parent.
// 3.2 If True then TernaryChecked is initialised to TernaryTrue, otherwise to
//       TernaryFalse.
// 3.3 If enabled, the load count is computed, but without view notification.
// 3.4 The views are notified of the node addition (not of a property change).

procedure TTestNode.SetEnabled( Value: boolean);
begin
if FEnabled = Value then exit;
if Value then
    begin
    if assigned( FParent) and (not FParent.Enabled) then
      FParent.Enabled := True;
    FEnabled := Value;
    UpdateTernaryChecked( False)
    end
  else
    begin
    DisableChildren;
    FEnabled := Value;
    UpdateTernaryChecked( False);
    end;
PropsChanged( [propEnabled]);
SetLoadCount( ComputeLoadCount)
end;


procedure TTestNode.UpdateTernaryChecked( doNotifications: boolean);
var
  NewTernaryChecked: TTernary;
  PEx: ITestNodeEx;
begin
if not FEnabled then
    NewTernaryChecked := TernaryFalse
  else if HaveAnyDisabledOrOmegaChildren then
    NewTernaryChecked := TernaryOmega
  else
    NewTernaryChecked := TernaryTrue;
if FTernaryChecked <> NewTernaryChecked then
  begin
  FTernaryChecked := NewTernaryChecked;
  if doNotifications then
    PropsChanged( [propEnabled]);
  if Supports( FParent, ITestNodeEx, PEx) then
    PEx.UpdateTernaryChecked( True)
  end
end;


procedure TTestNode.DisableChildren;
begin
end;



function TTestNode.HaveAnyDisabledOrOmegaChildren: boolean;
begin
result := False
end;

procedure TTestNode.SetEnabledDeepChildren;
begin
end;

procedure TTestNode.SetEnabledDeep( Value: boolean);
begin
FdoingSetEnabledDeep := True;
try
  FEnabled := Value;
  PropsChanged( [propEnabled]);
  SetEnabledDeepChildren;
  SetLoadCount( ComputeLoadCount)
finally
  FdoingSetEnabledDeep := False;
  end
end;

// ===============================================================

{ TTestNodeNonLeaf }

procedure TTestNodeNonLeaf.AddChild( const Newbie: ITestNode);
begin
FChildren.Add( Newbie)
end;


function TTestNodeNonLeaf.AddNewChild(
  Kind: TNodeKind; const Name: string): ITestNode;
begin
result := inherited AddNewChild( Kind, Name);
if assigned( FMaster) and (result.Kind <> nkTestCase) then
  FMaster.AddedNode( result)
end;


procedure TTestNodeNonLeaf.Clear;
var
  j: integer;
  Child: ITestNodeEx;
begin
inherited Clear;
for j := 0 to FChildren.Count - 1 do
  if Supports( FChildren[j], ITestNodeEx, Child) then
    Child.Clear
end;


function TTestNodeNonLeaf.ComputeExecutionCount: integer;
var
  j: integer;
  Child: ITestNode;
begin
result := inherited;
if FEnabled then
  for j := 0 to FChildren.Count - 1 do
    if Supports( FChildren[j], ITestNode, Child) then
      Inc( result, Child.ExecuteCount)
end;

function TTestNodeNonLeaf.ComputeFailCount: integer;
var
  j: integer;
  Child: ITestNode;
begin
result := inherited;
if FEnabled then
  for j := 0 to FChildren.Count - 1 do
    if Supports( FChildren[j], ITestNode, Child) then
      Inc( result, Child.FailCount)
end;

function TTestNodeNonLeaf.ComputeLoadCount: integer;
var
  j: integer;
  Child: ITestNode;
begin
result := inherited;
if FEnabled then
  for j := 0 to FChildren.Count - 1 do
    if Supports( FChildren[j], ITestNode, Child) then
      Inc( result, Child.LoadCount)
end;

procedure TTestNodeNonLeaf.DownwardExecCountChange(
  Delta: integer; const Child: ITestNode);
begin
if not FdoingSetEnabledDeep then
  SetExecuteCount( FExecuteCount + Delta)
end;

procedure TTestNodeNonLeaf.DownwardFailCountChange(Delta: integer;
  const Child: ITestNode);
begin
if not FdoingSetEnabledDeep then
  SetFailCount( FFailCount + Delta)
end;

procedure TTestNodeNonLeaf.DownwardLoadCountChange(Delta: integer;
  const Child: ITestNode);
begin
if not FdoingSetEnabledDeep then
  SetLoadCount( FLoadCount + Delta)
end;

procedure TTestNodeNonLeaf.DownwardExecutionResultChange(
  ChildResult: TExecutionResult; const Child: ITestNode);
var
  PassCount, FailCount, NullCount: integer;
  Sibling: ITestNode;
  j: integer;
begin
case ChildResult of
  erPass:
    begin
    PassCount := 0;
    FailCount := 0;
    NullCount := 0;
    for j := 0 to FChildren.Count - 1 do
      if Supports( FChildren[j], ITestNode, Sibling) then
        case Sibling.ExecutionResult of
          erPass: Inc( PassCount);
          erFail: Inc( FailCount);
          erNull: if Child.Enabled then
                    Inc( NullCount);
          end;
    if (PassCount > 0) and (FailCount = 0) and (NullCount = 0) then
      SetTestResult_Overall( erPass)
    end;
  erFail:
    SetTestResult_Overall( erFail)
  end
end;


procedure TTestNodeNonLeaf.DownwardStatusChange(
  Value: TTestStatus; const Child: ITestNode; Stamp: TDateTime);
var
  j: integer;
  Sibling: ITestNode;
  ReadyCount, ExecCount, DoneCount: integer;
begin
if (not FEnabled) or FdoingSkipDisabledDeep then exit;
ReadyCount := 0;
ExecCount  := 0;
DoneCount  := 0;
for j := 0 to FChildren.Count - 1 do
  if Supports( FChildren[j], ITestNode, Sibling) and Sibling.Enabled then
    case Sibling.GetStatus of
      sReady    : Inc( ReadyCount);
      sSettingUp, sTesting, sTearingDown: Inc( ExecCount);
      sDone     : Inc( DoneCount);
      end;
if (ReadyCount > 0) and (ExecCount = 0) and (DoneCount = 0) then
    SetStatus( sReady, Stamp)
  else if (ReadyCount = 0) and (ExecCount = 0) and (DoneCount > 0) then
    SetStatus( sDone, Stamp)
  else if ExecCount = 0 then
    SetStatus( sSkipped, Stamp)
  else
    SetStatus( sTesting, Stamp)
end;



function TTestNodeNonLeaf.GetChild( Idx: integer): ITestNode;
begin
if (Idx < 0) or (Idx >= FChildren.Count) or (not Supports( FChildren[Idx], ITestNode, result)) then
  result := nil
end;

function TTestNodeNonLeaf.GetCount: integer;
begin
result := FChildren.Count
end;

function TTestNodeNonLeaf.HaveAnyDisabledOrOmegaChildren: boolean;
var
  j: integer;
  Child: ITestNode;
begin
result := False;
if assigned( FChildren) then
  for j := 0 to FChildren.Count - 1 do
    if Supports( FChildren[j], ITestNode, Child) then
      begin
      result := Child.TernaryChecked in [TernaryFalse, TernaryOmega];
      if result then break
      end
end;

constructor TTestNodeNonLeaf.ServiceModeCreate;
begin
inherited ServiceModeCreate;
FChildren := TInterfaceList.Create
end;

procedure TTestNodeNonLeaf.SetEnabledDeepChildren;
var
  j: integer;
  Child: ITestNodeEx;
begin
for j := 0 to FChildren.Count - 1 do
  if Supports( FChildren[j], ITestNodeEx, Child) then
    Child.SetEnabledDeep( FEnabled)
end;

procedure TTestNodeNonLeaf.SkipDisabledDeepChildren;
var
  j: integer;
  Child: ITestNodeEx;
begin
for j := 0 to FChildren.Count - 1 do
  if Supports( FChildren[j], ITestNodeEx, Child) then
    Child.SkipDisabledDeep
end;


procedure TTestNodeNonLeaf.DisableChildren;
var
  j: integer;
  Child: ITestNode;
begin
for j := 0 to FChildren.Count - 1 do
  if Supports( FChildren[j], ITestNode, Child) then
    Child.Enabled := False
end;


end.
